Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
MODULE NetSystem;
(*BD, 13.2.96 *)
	IMPORT SYSTEM, Texts, Oberon, Input, B := AmigaNetBase;(* insert here the name of your specific module NetBase *)
	CONST
		(* res values *)
		done* = 0;	(*everything went ok*)
		error* = 1;	(*failure occured*)
		timeout* = 2;	(*opening a connection is timed out*)
		(* return values of procedure State *)
		closed* = 0;	(*connection is closed (neither sending nor receiving)*)
		listening* = 1;	(*passive connection is listening for a request*)
		in* = 2;	(*receiving only*)
		out* = 3;	(*sending only*)
		inout* = 4;	(*sending and receiving is possible*)
		(* any port value *)
		anyport* = 0;
		anyaddr = 0;
		buffersize = 1024;
	TYPE
IPAdr* = B.IPAdr;	(* Internet Address, where IPAdr[0] contains the most significant byte *)
		Connection* = POINTER TO ConnectionDesc;	(* TCP-Connection *)
		ConnectionDesc* = RECORD
			socket: LONGINT;
			state: INTEGER;
			res*: INTEGER;	(*result of LRU operation on a connection (error indication)*)
			recvbuffer: ARRAY buffersize OF SYSTEM.BYTE;
			nofelems, begidx, endidx: LONGINT;
		END;
		Socket*= POINTER TO SocketDesc;	(* UDP-Connection *)
		SocketDesc* = RECORD
			socket: LONGINT;
			res*: INTEGER;	(*result of LRU operation on a socket (error indication)*)
		END;
		hostname*, gateway*: ARRAY 65 OF CHAR;
		user*, passwd*: ARRAY 17 OF CHAR;
		hostIP*, anyIP*, allIP*: IPAdr;
	PROCEDURE Minimum(a, b: LONGINT): LONGINT;
	BEGIN
		IF a <= b THEN RETURN a ELSE RETURN b END
	END Minimum;
	PROCEDURE Start*;
		VAR 
			R: Texts.Reader; 
			ch: CHAR; 
			i, j, k, l: INTEGER;
			err: LONGINT;
			namePtr, namelen: LONGINT;
	BEGIN
		(********* Get Username/Password *********)
		i := 0; j := 0;
		Texts.OpenReader(R, Oberon.Par.text, Oberon.Par.pos);
		REPEAT Texts.Read(R, ch) UNTIL ch # " ";
		IF (ch = 0DX) OR (ch = "%") OR (ch = "/") THEN Input.Read(ch);
			WHILE (ch > " ")  & (ch # "%") & (ch # "/") & (ch # "@") DO
				IF i # 16 THEN user[i] := ch; INC(i) END; Input.Read(ch)
			END;
			IF (ch = "%") OR (ch = "/") THEN Input.Read(ch);
				WHILE ch >= " " DO
					IF j # 16 THEN passwd[j] := ch; INC(j); END; Input.Read(ch)
				END
			END
		ELSE
			WHILE (ch > " ") & (ch # "%") & (ch # "/") DO
				IF i # 16 THEN user[i] := ch; INC(i) END; Texts.Read(R, ch)
			END;
			IF (ch = "%") OR (ch = "/") THEN Input.Read(ch);
				WHILE ch >= " " DO
					IF j # 16 THEN passwd[j] := ch; INC(j) END; Input.Read(ch)
				END
			END
		END;
		user[i] := 0X; passwd[j] := 0X;
		(********* Start NetSystemBase *********)
		B.Start();
		(******** Get HostName, convert it to hostIP ***********)
		IF B.done THEN 
			B.GetHostName(hostname);
			IF B.done THEN 
				B.GetHostByName(hostname, hostIP);
			END
		END
	END Start;
	PROCEDURE Stop*;
	BEGIN
		B.Stop()
	END Stop;
	PROCEDURE GetIP* (name: ARRAY OF CHAR; VAR IP: IPAdr);
		VAR done: BOOLEAN;
	BEGIN
		IF ('0' <= name[0]) & (name[0] <= '9') THEN B.GetHostByIP(name, IP)		(* dotted-decimal number *)
		ELSIF ('A' <= CAP(name[0])) & (CAP(name[0]) <= 'Z') THEN B.GetHostByName(name, IP)	(* human name *)
		ELSE IP:= anyIP
		END;
		IF ~B.done THEN IP:= anyIP END
	END GetIP;
	PROCEDURE GetName* (IP: IPAdr; VAR name: ARRAY OF CHAR);
	BEGIN
		B.GetHostByAdr(IP, name);
		IF ~B.done THEN name[0]:= 0X END
	END GetName;
(************************************** TCP ****************************************)
	PROCEDURE ReceiveBuffer(C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; pos: LONGINT; VAR len: LONGINT);
		VAR length, help: LONGINT;
	BEGIN
		length:= 0;
		LOOP
			help:= len-length;
			B.Recv(C.socket, buf, pos+length, help);
			IF B.done THEN
				INC(length, help);
				IF length >= len THEN EXIT END
			ELSE
				EXIT
			END
		END;
		IF length >= len THEN C.res:=done ELSE C.res:= error END
	END ReceiveBuffer;
	PROCEDURE Available* (C: Connection): LONGINT;
		VAR available, err, len: LONGINT;
			ok: BOOLEAN;
	BEGIN
		available:= 0;
		IF (C.state=inout) OR (C.state=in) THEN 
			available:= B.Available(C.socket);
			IF B.done & (available > 0)  THEN
				len:= Minimum(Minimum(buffersize - C.nofelems, buffersize - C.endidx), available);
				ReceiveBuffer(C, C.recvbuffer, C.endidx, len);
				IF C.res = done THEN
					INC(C.nofelems, len);
					C.endidx:= (C.endidx + len) MOD buffersize;
					available:= available - len
				END
			ELSIF available = -1 THEN
				C.res:= error;
				available:= 0	(* reset available to have a correct return value *)
			ELSE C.res:= done	(* available = 0 *)
			END
		END;
		RETURN available + C.nofelems
	END Available;
	PROCEDURE Receive(C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER);
		VAR err, available: LONGINT;
	BEGIN
		IF (C.state=inout) OR (C.state=in) THEN 
			WHILE (C.nofelems > 0) & (len > 0) DO
				buf[beg]:= C.recvbuffer[C.begidx];
				INC(beg); C.begidx:= (C.begidx + 1) MOD buffersize;
				DEC(len); DEC(C.nofelems)
			END;
			WHILE len > 0 DO
				available:= B.Available(C.socket);
				IF B.done & (available > 0) THEN
					available:= Minimum(available, len);
					ReceiveBuffer(C, buf, beg, available);
					IF C.res= done THEN
						INC(beg, len); DEC(len, available)
					END
				ELSE C.res:= error; len := 0;
				END
			END
		ELSE C.res:= error	(* Reveive on a Connection with state=out OR state=listening *)
		END;
		res:= C.res
	END Receive;
	PROCEDURE Send(C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER);
		VAR help: LONGINT;
	BEGIN
		IF (C.state=inout) OR (C.state=out) THEN
			WHILE len > 0 DO
				help:= len;
				B.Send(C.socket, buf, beg, help);
				IF B.done THEN
					res:= done;
					DEC(len, help);
					INC(beg, help)
				ELSE 
					res:= error;
					len:= 0
				END
			END;
		ELSE res:= error	(* Send on a Connection with state=in OR state=listening *)
		END;
		C.res:= res
	END Send;
PROCEDURE OpenConnection* (VAR C: Connection; locPort: INTEGER; remIP: IPAdr; remPort: INTEGER; 
													VAR res: INTEGER);
		VAR socket, err: LONGINT;
			myaddr, partneraddr : B.Sockaddrin;
	BEGIN
		IF remPort = anyport THEN remIP:= anyIP END;
		B.Socket(socket, B.AFINET, B.SOCKSTREAM, B.IPPROTOTCP);
		IF B.done THEN
			IF remIP = anyIP THEN	(* TCP-Server *)
				myaddr.sinfamily:= B.AFINET;
				myaddr.sinaddr:= anyIP;
				myaddr.sinport:= B.IntToNet(locPort);
				B.Bind(socket, myaddr);
				IF B.done THEN
					B.Listen(socket);
					IF B.done THEN
						B.SetLinger(socket);
						NEW(C);
						C.socket:= socket;
						C.state:= listening;
						C.nofelems:= 0; C.begidx:= 0; C.endidx:= 0;
						C.res:= done;
						res:= done
					ELSE B.Close(socket); res:= error
					END
				ELSE B.Close(socket); res:= error
				END
			ELSE	(* TCP-Client *)
				partneraddr.sinfamily:= B.AFINET;
				partneraddr.sinaddr:= remIP;
				partneraddr.sinport:= B.IntToNet(remPort);
				B.Connect(socket, partneraddr);
				IF B.done THEN
					B.SetLinger(socket);
					NEW(C);
					C.socket:= socket;
					C.state:= inout;
					C.nofelems:= 0; C.begidx:= 0; C.endidx:= 0;
					C.res:= done;
					res:= done
				ELSE
					B.Close(socket);
					res:= error
				END
			END
		END
	END OpenConnection;
	PROCEDURE CloseConnection* (C: Connection);
		VAR err: LONGINT;
	BEGIN
		IF C # NIL THEN
			B.Close(C.socket);
			IF B.done THEN 
				C.res:= done;
				C.state:= closed
			ELSE C.res:= error
			END
		END
	END CloseConnection;
	PROCEDURE Requested* (C: Connection): BOOLEAN;
	BEGIN
		RETURN (C.state = listening) & B.Requested(C.socket) & (B.done)
	END Requested;
	PROCEDURE Accept* (C: Connection; VAR newC: Connection; VAR res: INTEGER);
		VAR newsocket: LONGINT;
			ok: BOOLEAN;
	BEGIN
		IF C.state= listening THEN
			B.Accept(C.socket, newsocket);
			IF B.done THEN 
				NEW(newC);
				newC.socket:= newsocket;
				newC.state:= inout;	
				newC.res:= done;
				newC.nofelems:= 0; newC.begidx:= 0; newC.endidx:= 0;
				res:=done
			ELSE res:= error
			END
		ELSE res:= error
		END
	END Accept;
	PROCEDURE State* (C: Connection): INTEGER;
	BEGIN
		IF (~B.Connected(C.socket)) & (B.done) THEN C.state:= closed END;
		RETURN C.state
	END State;
	PROCEDURE GetPartner* (C:Connection; VAR remIP: IPAdr; VAR remPort: INTEGER);
		VAR addr: B.Sockaddrin;
			len, err: LONGINT;
	BEGIN
		B.GetPeerName(C.socket, addr);
		IF B.done THEN remIP:= addr.sinaddr; remPort:= addr.sinport
		ELSE remIP:= anyIP; remPort:= anyport
		END
	END GetPartner;
	(*----- Read -----*)
	PROCEDURE Read* (C: Connection; VAR ch: CHAR);
	BEGIN Receive(C, ch, 0, 1, C.res)
	END Read;
	PROCEDURE ReadBytes* (C: Connection; pos, len: LONGINT; VAR buf: B.Data);
	BEGIN Receive(C, buf, pos, len, C.res);
	END ReadBytes;
	PROCEDURE ReadBool* (C: Connection; VAR b: BOOLEAN);
	BEGIN Receive(C, b, 0, 1, C.res);
	END ReadBool;
	PROCEDURE ReadInt* (C: Connection; VAR x: INTEGER);
	BEGIN Receive(C, x, 0, 2, C.res); x:= B.NetToInt(x)
	END ReadInt;
	PROCEDURE ReadLInt* (C: Connection; VAR x: LONGINT);
	BEGIN Receive(C, x, 0, 4, C.res); x:= B.NetToLInt(x);
	END ReadLInt;
	PROCEDURE ReadString* (C: Connection; VAR s: ARRAY OF CHAR);
		ch, ch0: CHAR;
		i: INTEGER;
	BEGIN i := -1; ch := 0X;
		REPEAT INC(i);
			ch0 := ch; Receive(C, ch, 0, 1, C.res); s[i] := ch;
		UNTIL (C.res = error) OR (ch = 0X) OR (ch = 0AX);
		IF (ch = 0AX) & (ch0 = 0DX) THEN s[i - 1] := 0X
		ELSE s[i] := 0X
		END
	END ReadString;
	(*----- Write -----*)
	PROCEDURE Write* (C: Connection; ch: CHAR);
	BEGIN Send(C, ch, 0, 1, C.res)
	END Write;
	PROCEDURE WriteBytes* (C: Connection; pos, len: LONGINT; VAR buf: B.Data);
	BEGIN Send(C, buf, pos, len, C.res)
	END WriteBytes;
	PROCEDURE WriteBool* (C: Connection; b: BOOLEAN);
	BEGIN Send(C, b, 0, 1, C.res)
	END WriteBool;
	PROCEDURE WriteInt* (C: Connection; x: INTEGER);
	BEGIN x:= B.IntToNet(x); Send(C, x, 0, 2, C.res)
	END WriteInt;
	PROCEDURE WriteLInt* (C: Connection; x: LONGINT);
	BEGIN x:= B.LIntToNet(x); Send(C, x, 0, 4, C.res)
	END WriteLInt;
	PROCEDURE WriteString* (C: Connection; s: ARRAY OF CHAR);
		cs: ARRAY 2 OF CHAR;
		i: INTEGER;
	BEGIN  i := 0;
		WHILE s[i] # 0X DO INC(i) END;
		Send(C, s, 0, i, C.res);
		cs[0] := 0DX; cs[1] := 0AX;
		Send(C, cs, 0, 2, C.res)
	END WriteString;
(******************************** UDP **************************************)
	PROCEDURE OpenSocket* (VAR S: Socket; locPort: INTEGER; VAR res: INTEGER);
		VAR socket, err, port: LONGINT;
			myaddr: B.Sockaddrin;
	BEGIN
		B.Socket(socket, B.AFINET, B.SOCKDGRAM, B.IPPROTOUDP);
		IF B.done THEN
			IF locPort # anyport THEN
				myaddr.sinfamily:= B.AFINET;
				myaddr.sinaddr:= anyIP;
				myaddr.sinport:= B.IntToNet(locPort);
				B.Bind(socket, myaddr);
				IF B.done THEN 
					NEW(S);
					S.socket:= socket;
					S.res:= done;
					res:= done;
				ELSE 
					B.Close(socket);
					res:= error
				END
			END
		END
	END OpenSocket;
	PROCEDURE CloseSocket* (S: Socket);
		VAR err: LONGINT;
	BEGIN
		B.Close(S.socket);
	END CloseSocket;
	PROCEDURE AvailableDG* (S: Socket): LONGINT;
		VAR err, result: LONGINT;
	BEGIN
		RETURN B.Available(S.socket)
	END AvailableDG;
	PROCEDURE SendDG* (S: Socket; remIP: IPAdr; remport: INTEGER; pos, len: LONGINT; VAR buf: B.Data);
		VAR remaddr: B.Sockaddrin;
			addr, res: LONGINT;
			ok: BOOLEAN;
	BEGIN
		remaddr.sinfamily:= B.AFINET;
		remaddr.sinport:= B.IntToNet(remport);
		remaddr.sinaddr:= remIP;
		B.SendTo(S.socket, remaddr, buf, pos, len);
		IF B.done THEN S.res := done
		ELSE S.res:= error
		END
	END SendDG;
	PROCEDURE ReceiveDG* (S: Socket; VAR remIP: IPAdr; VAR remport: INTEGER; pos: LONGINT; VAR len: LONGINT; VAR buf: B.Data);
		VAR remaddr: B.Sockaddrin;
	BEGIN
		B.RecvFrom(S.socket, remaddr, buf, pos, len);
		IF B.done THEN 
			remIP:= remaddr.sinaddr;
			remport:= B.NetToInt(remaddr.sinport);
			S.res:= done;
		ELSE 
			S.res:=error
		END
	END ReceiveDG;
	PROCEDURE PutInt* (VAR buf: B.Data; pos, x: INTEGER);
	BEGIN
		ASSERT(pos <= LEN(buf) - SIZE(INTEGER));
		x:= B.IntToNet(x);
		SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(buf[pos]), SIZE(INTEGER))
	END PutInt;
	PROCEDURE PutLInt* (VAR buf: B.Data; pos: INTEGER; x: LONGINT);
	BEGIN
		ASSERT(pos <= LEN(buf) - SIZE(LONGINT));
		x:= B.LIntToNet(x);
		SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(buf[pos]), SIZE(LONGINT))
	END PutLInt;
	PROCEDURE GetInt* (VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; VAR x: INTEGER);
	BEGIN
		ASSERT(pos <= LEN(buf) - SIZE(INTEGER));
		SYSTEM.MOVE(SYSTEM.ADR(buf[pos]), SYSTEM.ADR(x), SIZE(INTEGER));
		x:= B.NetToInt(x)
	END GetInt;
	PROCEDURE GetLInt* (VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; VAR x: LONGINT);
	BEGIN
		ASSERT(pos <= LEN(buf) - SIZE(LONGINT));
		SYSTEM.MOVE(SYSTEM.ADR(buf[pos]), SYSTEM.ADR(x), SIZE(LONGINT));
		x:= B.NetToLInt(x)
	END GetLInt;
BEGIN 
	anyIP[0] := CHR(0); anyIP[1] := CHR(0); anyIP[2] := CHR(0); anyIP[3] := CHR(0)
END NetSystem.